    IOI. 6 (Insule n mare) Marea este reprezentata printr-o retea patrata de 
ordin N (1N8). Fiecare insula este identificata pe retea prin caracterul '*'.
Problema consta din a reconstrui o harta a insulelor plecnd de la o informatie 
codificata asupra distributiei pe orizontala si verticala a insulelor. Un
exemplu de harta si de informatie codificata este urmatorul:
*     *  *                                                   1 2
   *  *  *     *                         3 1
*     *     *                                               1 1 1
   *  *  *  *  *                         5
*  *     *     *                         2 1 1
         *                                                     1

1  1  4  2  2  1
1  2     3     2
1

    Numerele din dreapta fiecarei linii reprezinta n ordine marimea grupurilor
de insule adiacente situate pe acea linie. De exemplu, cifrele '1 2' care 
ncheie prima linie semnifica faptul ca pe aceasta linie apare un grup format 
dintr-o insula, urmat la dreapta de un grup format din doua insule; grupurile
de insule sunt separate ntre ele prin cel putin un blanc. Similar, secventa 
'1 1 1' care apare sub prima coloana arata ca pe aceasta coloana apar trei 
grupuri de insule, fiecare grup fiind format dintr-o singura insula.
Se cere sa se scrie un program care repeta urmatorii pasi pna cnd un fisier 
de intrare dat, continnd mai multe blocuri de informatie, este citit n 
ntregime:
   1) Citeste urmatorul bloc de informatie din fisierul de intrare ASCII (cu 
structura din exemplele de mai jos) si-l afiseaza pe ecran. Fiecare bloc de 
informatie consta din ordinul retelei patrate, urmat de restrictiile referitoare 
la linii si apoi de restrictiile referitoare la coloane. Fiecare restrictie 
apare pe o singura linie a fisierului ca o secventa de numere separate prin 
blancuri si terminata cu 0;
   2) Reconstruiti harta (sau hartile daca exista mai mult de o solutie) afisnd rezultatul pe ecran;
   3) Scrieti harta (hartile) la sfrsitul unui fisier de iesire ASCII. Fiecare 
blanc se reprezinta ca o succesiune de doua blancuri, iar fiecare insula trebuie 
reprezentata de caracterul '*' urmat de un blanc. Diferitele harti corespunzatoare 
aceluiasi bloc de informatie trebuie separate printr-o linie goala. Daca nu
exista nici o harta corespunzatoare blocului de informatie, indicati acest lucru 
printr-o linie continnd mesajul 'no map'. Solutiile pentru diferitele blocuri 
de informatie trebuie separate printr-o linie continnd mesajul 'next problem'.
Exemple:
6-                                    ordinul retelei
1 2 0-                    nceputul restrictiilor pentru linii
3 1 0
1 1 1 0
5 0
2 1 1 0
1 0
1 1 1 0-                  nceputul restrictiilor pentru coloane
1 2 0
4 0
2 3 0
2 0
1 2 0

4                                     Solutie:   1  2  3  4
0                                                                                                            1
1 0                                                                                                    2        *
2 0                                                                                                    3     *  *
0                                                                                                            4
0
1 0
2 0
0

2                                     Solutie: no map
0
0
2 0
2 0

2                                     Sunt doua solutii diferite.
1 0
1 0
1 0
1 0
======================================
Solutia 1 (Peter Szolt)

  Fiindca problema cere toate solutiile, am folosit un backtracking. In fiecare
pas am verificat ca se poate sa fie, sau se poate sa nu fie o insula la un
anumit loc.

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
program IOI6;
const
  Rezultat='con';
  Max=8;
var
 s,s2:string;
 f,g:text;
 linii,col,ered:array[1..Max,0..Max] of byte;
 n,i,c,x,y:byte;
 j:integer;
 a:array[1..Max,1..Max] of char;
 cc:array[1..Max] of byte;
 volt:boolean;
 nr,co:word;
procedure rez;
var i,j:byte;
begin
  if volt then writeln(g);
  for i:=1 to n do begin
    for j:=1 to n do write(g,a[i,j]:2);
    writeln(g);
  end;
  volt:=true;
end;
function canput:boolean;
begin
  if ((cc[x]=0) and (col[x,0]>0)) or
    ((cc[x]<>0) and ((col[x,cc[x]]>0) or (cc[x]<col[x,0]))) then canput:=true else

    canput:=false;
end;
function canskip:boolean;
begin
  if (cc[x]<>0) and (col[x,cc[x]]<>0) then canskip:=false else begin
    canskip:=true;
  end;
end;

procedure rek(can:boolean);
var i:byte;
begin
  if y>n then begin if nr=co then rez;end else
  if x>n then begin
    if (linii[y,0]<>c) or (linii[y,c]<>0) then exit;
    i:=c;
    x:=1;
    c:=0;
    inc(y);
    rek(true);
    dec(y);
    c:=i;
    x:=n+1;
  end else begin
    if (can) and (c<=linii[y,0]) then begin
      if (c=0) or (linii[y,c]=0) and (c<linii[y,0]) then inc(c);
      if canput then begin
        if (y=1) or (a[y-1,x]=' ') then inc(cc[x]);
        if cc[x]<=col[x,0] then begin
          if col[x,cc[x]]>0 then begin
            inc(co);
            dec(col[x,cc[x]]);
            a[y,x]:='*';
            dec(linii[y,c]);
            inc(x);
            if linii[y,c]=0 then begin
              rek(false);
            end else rek(true);
            dec(x);
            inc(linii[y,c]);
            a[y,x]:=' ';
            dec(co);
            inc(col[x,cc[x]]);
          end;
        end;
        if ((y=1) or (a[y-1,x]=' ')) then dec(cc[x]);
      end;
      if (linii[y,c]=ered[y,c]) then dec(c);
    end;
    if (c=0) or (c>linii[y,c]) or (linii[y,c]=0) then begin
      if canskip then begin
        inc(x);
        rek(true);
        dec(x);
      end;
    end;
  end;
end;

procedure cut;
begin
  while s[1]=' ' do delete(s,1,1);
end;
begin
  write('Fisierul de intrare:');
  readln(s);
  assign(f,s);
  assign(g,Rezultat);
  reset(f);
  rewrite(g);
  while not eof(f) do begin
    readln(f,n);
    nr:=0;
    co:=0;
    for i:=1 to n do begin
       readln(f,s);
       cut;
       linii[i,0]:=0;
       while s<>'0' do begin
         j:=pos(' ',s);
         s2:=copy(s,1,j-1);
         s:=copy(s,j+1,byte(s[0])-j);
         inc(linii[i,0]);
         val(s2,linii[i,linii[i,0]],j);
         nr:=nr+linii[i,linii[i,0]];
         cut;
       end;
    end;
    for i:=1 to n do begin
       readln(f,s);
       cut;
       col[i,0]:=0;
       while s<>'0' do begin
         j:=pos(' ',s);
         s2:=copy(s,1,j-1);
         s:=copy(s,j+1,byte(s[0])-j);
         inc(col[i,0]);
         val(s2,col[i,col[i,0]],j);
         co:=co+col[i,col[i,0]];
         cut;
       end;
    end;
    readln(f);
    fillchar(cc,sizeof(cc),0);
    fillchar(a,sizeof(a),' ');
    c:=0;
    x:=1;
    y:=1;
    volt:=false;
    ered:=linii;
    if co=nr then begin co:=0;rek(true);end;
    if volt=false then writeln(g,'no map');
    if not seekeof(f) then writeln(g,'next problem');
    flush(g);
  end;
  close(f);
  close(g);

end.
------------------------------------------
Solutia mea:
Algoritm:
Ideea este de a folosi un ablon - un vector binar care constituie soluia unei restricii (se marcheaz[
cu 1 poziia unei insule i cu 0 absena ei), cu proprietatea c[ num[rul asociat este minim.
De exemplu, pentru restricia 1 2 sunt posibile trei abloane: (0 0 1 0 1 1),(0 1 0 0 1 1),
(1 0 0 0 1 1). Orice alt[ configuraie posibil[ a liniei se poate obine din aceste abloane prin
translatare spre stnga ct timp nu se pierde nici un 1; aritmetic, aceasta este echivalent[ cu nmulirea
cu 2 a num[rului asociat ablonului.
Este foarte simplu de a construi algoritmi care:
i) Plecnd de la o restricie, s[ construiasc[ abloanele ei;
ii) Pentru fiecare ablon, s[ genereze num[rul binar asociat precum i translat[rile sale.
Algoritmul de rezolvare al problemei va lucra atunci astfel:
1. Se citete n (ordinul reelei);
2. Pentru i:=1,n
   2.1. Se citete restricia i (pentru linii);
   2.2. Se construiesc numerele care formeaz[ abloanele; fie p1,..,pk
reprezentarea lor n zecimal;
   2.3. Se construiete mulimea Li=B1jk{t*pj|t=1,2,..,r, (r+1)*pj>2n-1}
(cu ajutorul a dou[ cicluri);
3. Pentru i:=1,n
   3.1. Se citete restricia i (pentru coloane);
   3.2. Se construiesc numerele care formeaz[ abloanele; fie q1,..,qk
reprezentarea lor n zecimal;
   3.3. Se construiete mulimea Ci=B1jk{t*qj|t=1,2,..,r, (r+1)*qj>2n-1}
(cu ajutorul a dou[ cicluri);
 4. Printr-un algoritm de tip backtracking se determin[ dac[ exist[
dou[ matrici patrate L=(b1 b2 .. bn)T, C=(c1 c2 .. cn)T unde bi este
scrierea n binar a unui num[r din Li, ci este scrierea n binar a unui
num[r din Ci, cu proprietatea c[ L(i,j)=C(j,i) zi,j 1i,jn.
In caz afirmativ, L este chiar soluia problemei. Altfel, nu exist[
soluie.
              Este interesant faptul c[ restricia din problem[ 1N8 permite un algoritm foarte uor de
implementat n C, unde este posibil de lucrat cu bii. Aloritmul de sus se implementeaz[ asociind cte
un octet fiec[rei restricii.
Program:
uses crt;
type line=array[1..9] of byte;
     info_line=record
               a:array[1..4] of byte;
               islands,stars:byte;
               end;
var sea:array[1..8] of line;
    linii,coloane:array[1..8] of info_line;
    i,j,N:integer;
    gasit,last,sfarsit:boolean;
    input,output:text;
---------------------------------------------------
procedure next_line(var
l:line;s,is:integer);
var i,stars,islands:integer;
    on:boolean;
    input:text;
begin
last:=false;
l[N+1]:=0;
repeat
      inc(l[1]);
      stars:=0;
      islands:=0;
      on:=false;
      for i:=1 to N do
          begin
          if l[i]=2 then
             begin
             l[i]:=0;
             inc(l[i+1]);
             end;
          if l[i]=1 then
             begin
             inc(stars);
             if not on then on:=true;
             end;
          if on and ((l[i]=0) or (i=N)) then
             begin
             on:=false;
             inc(islands);
             end;
          end;
until (stars=s) and (islands=is);
{for i:=1 to N do write(l[i],' ');
write('  -  ',stars,' ',islands);}
last:=(l[N+1]<>0);
end;
---------------------------------------------------
procedure read_info(var
linii:info_line);
var i:integer;
    ends:boolean;
begin
i:=1;
ends:=false;
while (i<=N) and (not ends) do
    begin
    read(input,linii.a[i]);
    ends:=(linii.a[i]=0);
    linii.stars:=linii.stars+linii.a[i];
    inc(i);
    end;
readln(input);
linii.islands:=i-2;
{for i:=1 to N do write(linii.a[i],' ');
writeln('  -  ',linii.stars,' ',linii.islands);}
end;
---------------------------------------------------
procedure write_solution;
var i,j:integer;
begin
writeln(output);
for i:=1 to N do
    begin
    for j:=1 to N do write(output,sea[i][j],' ');
    writeln(output);
end;
---------------------------------------------------
function vcoloane:boolean;
var ok,on:boolean;
    i,j,stars,stars1,islands:integer;
begin
i:=1;
ok:=true;
while (i<=N) and ok do
      begin
      islands:=0;
      stars1:=0;
      stars:=0;
      on:=false;
      for j:=1 to n do
          begin
          if sea[j][i]=1 then
             begin
             inc(stars);
             on:=true;
             end;
          if on and ((sea[j][i]=0) or (j=N)) then
             begin
             inc(islands);
         if coloane[i].a[islands]<>stars-stars1
             then ok:=false;
             on:=false;
             stars1:=stars;
             end;
          end;
      if (islands<>coloane[i].islands) or
 (stars<>coloane[i].stars) then ok:=false;
      inc(i);
      end;
vcoloane:=ok and (i<=N+1);
end;
---------------------------------------------------
procedure arrange;
var i,j:integer;
begin
next_line(sea[1],linii[1].stars,linii[1].islands);
for i:=1 to N do
    if last then
       begin
       for j:=1 to N do sea[i][j]:=0;
 next_line(sea[i],linii[i].stars,linii[i].islands);
       next_line(sea[i+1],linii[i+1].stars,
   linii[i+1].islands);
       if i=N then sfarsit:=true;
       end;
end;
---------------------------------------------------
begin
clrscr;
assign(input,'input');
assign(output,'output.io6');
rewrite(output);
reset(input);
while not eof(input) do
      begin
      gasit:=false;
      readln(input,N);
      for i:=1 to N do
          begin
          read_info(linii[i]);
          for j:=1 to N do sea[i][j]:=0;
          end;
      for i:=1 to N do read_info(coloane[i]);
      sfarsit:=false;
      repeat
            arrange;
            if vcoloane then
               begin
               gasit:=true;
               write_solution;
               end;
      until sfarsit;
      writeln(output);
      if not gasit then writeln(output,'No map');
      readln(input);
      end;
close(input);
close(output);
end.
-------------------------------------------
